home *** CD-ROM | disk | FTP | other *** search
/ Mars Digital Image Map / Mars Digital Image Map - Disc 6.iso / software / vax / mdimdisp.for < prev    next >
Text File  |  1991-09-05  |  17KB  |  496 lines
  1. C***********************************************************************
  2. C 
  3. C_TITLE: MDIMDISP - Display an MDIM image on a Micro-VAX/GPX workstation 
  4. C
  5. C_DESCR: This software is a highly-simplified example program for display
  6. C        of MDIM images located on CDROM media. The program is designed
  7. C        to demonstrate how to extract image data from an MDIM file and 
  8. C        then display the data.
  9. C
  10. C        The program was developed exclusively for a VAX-station with a
  11. C        GPX color display. See Micro-VMS Workstation Software: Graphics
  12. C        Programming Guide (version 3.0, May 1986) for a description
  13. C        of the graphics routines used in this program.
  14. C
  15. C        The program assumes there is a standard VAX/VMS software 
  16. C        interface to the CDROM disc. Currently, under version 5 of
  17. C        VMS there is not a system interface to the ISO/CDROM standard.
  18. C        However, there is a DEC beta-test version CDROM interface,
  19. C        "VFS Mount Field Test Tool Kit", that provides access to ISO
  20. C        standard disks. The driver software is not generally available
  21. C        from DEC. It can be obtained from Jason Hyon, PDS, at the 
  22. C        following address:
  23. C 
  24. C        Jason Hyon
  25. C        Jet Propulsion Laboratory
  26. C        MS 168-514
  27. C        4800 Oak Grove Drive
  28. C        Pasadena, CA 91109
  29. C
  30. C        The program functions as follows:
  31. C        1) MDIMDISP will prompt the user for the desired size of the
  32. C           window used for display of the image. The default display
  33. C           size is 15 centimeters.
  34. C        2) Next the users is prompted to input the name of the
  35. C           CDROM image file to display.
  36. C        3) The display window is then created for eventual display
  37. C           of the image data.
  38. C        4) The program reads the entire image into memory
  39. C        5) An "auto-stretch" is performed on the image data to generate
  40. C           an optimum display of the data.
  41. C        6) The image is then send to the display window.
  42. C        7) The program prompts the user for the next image to display.
  43. C
  44. C        The program works best with the 1/64-th degree scale MDIM images 
  45. C        because these images fit nicely into the default window size. It
  46. C        is possible to display larger images with MDIMDISP. However, only
  47. C        a part of the whole image can be viewed at any given time. The
  48. C        program initially displays as much data as can be viewed in the
  49. C        display window. The lower-left part of the image will be displayed.
  50. C        Other parts of the image can be display by altering the size of the
  51. C        window with the mouse control (the standard mouse control features
  52. C        are utilized.)
  53. C
  54. C        The program can be complied and linked with the simple commands:
  55. C        $FOR  MDIMDISP
  56. C        $LINK MDIMDISP
  57. C
  58. C        This program was adapted from the CDIMAGE software created by
  59. C        Robert Mehlman at UCLA/IGPP.
  60. C
  61. C_HIST   28May87 RMehlman, UCLA/IGPP, Original version called CDIMAGE
  62. C        21Jul91 EEliason, USGS, Modified to work on MDIM images
  63. C
  64. C***************************************************************************
  65.       PROGRAM MDIMDISP
  66.       IMPLICIT INTEGER(U-W)
  67.       INCLUDE 'SYS$LIBRARY:UISENTRY'
  68.       INCLUDE 'SYS$LIBRARY:UISUSRDEF'
  69.       PARAMETER (MCOUNT=256)
  70.       CHARACTER*64 IFILE
  71.       REAL*4 R(0:MCOUNT),G(0:MCOUNT),B(0:MCOUNT)
  72.       INTEGER*4 VCM_ATT(3),CMS_ID
  73.       
  74.       BYTE KBUF(8000000)
  75.  
  76.       INTEGER*4      IHIST(256)
  77.       CHARACTER*4096 HSTR
  78.       EQUIVALENCE (HSTR,IHIST)
  79.  
  80.       CHARACTER*4096 STR
  81.       BYTE BUF(4096)
  82.       EQUIVALENCE (STR,BUF)
  83.  
  84.       REAL*4 HIST(256),XHIST(256)
  85.  
  86.       REAL*4 X1,Y1,X2,Y2,WIDTH,HEIGHT,SIZE,DEFSIZ
  87.       DATA  X1, Y1,  X2,  Y2,DEFSIZ
  88.      1    /0.0,0.0,100.0,100.0,  15./
  89.  
  90.       DATA IIN,IOUT,LBLK,ICOUNT, IEXCL,NLEV
  91.      1    /  5,   6, 512,   128,-32768, 128/
  92.  
  93.  
  94.       DATA NHIST/256/
  95.       COMMON/PRT/ IOUT,IIN
  96.  
  97. C***********************************************************************
  98. C Enter the viewport size in centimeters
  99. C***********************************************************************
  100.       WRITE (IOUT,900)
  101.  900  FORMAT ('$Enter side of viewport in centimeters (default 15.): ')
  102.       READ (IIN,901) SIZE
  103.  901  FORMAT (F10.0)
  104.  
  105.       IF (SIZE.LE.0.) SIZE=DEFSIZ
  106.       WIDTH=SIZE
  107.       HEIGHT=SIZE
  108.  
  109.       IFIRST = 0
  110.  
  111. C***********************************************************************
  112. C Top of loop. Prompt user for the name of the MDIM file 
  113. C***********************************************************************
  114.  1000 CONTINUE
  115.  
  116.       WRITE(IOUT,903)
  117.   903 FORMAT('$Enter MDIM input file to display: ')
  118.       READ(IIN,904,END=9000) IFILE
  119.   904 FORMAT(A)
  120.  
  121.       ID=10
  122.       OPEN (UNIT=ID,NAME=IFILE,STATUS='OLD',ACCESS='SEQUENTIAL',
  123.      . FORM='FORMATTED',READONLY)
  124.  
  125. C************************************************************************
  126. C  Set up for colors and for display
  127. C************************************************************************
  128.       IF (IFIRST.EQ.0) THEN
  129.         IFIRST = 1
  130.         VCM_ATT(1)=VCMAL$C_ATTRIBUTES
  131.         VCM_ATT(2)=VCMAL$M_NO_BIND
  132.         VCM_ATT(3)=VCMAL$C_END_OF_LIST
  133.         VCM_ID=UIS$CREATE_COLOR_MAP(ICOUNT,,VCM_ATT)
  134.         CMS_ID=UIS$CREATE_COLOR_MAP_SEG(VCM_ID,'SYS$WORKSTATION',
  135.      .   UIS$C_COLOR_GENERAL)
  136.         VD_ID=UIS$CREATE_DISPLAY(X1,Y1,X2,Y2,WIDTH,HEIGHT,VCM_ID)
  137.         WD_ID=UIS$CREATE_WINDOW(VD_ID,'SYS$WORKSTATION','IMAGE')
  138.         CALL COLORSET(R,G,B,ICOUNT)
  139.         CALL UIS$SET_COLORS(VD_ID,0,ICOUNT,R,G,B)
  140.         CALL UIS$SET_WRITING_MODE(VD_ID,1,1,UIS$C_MODE_COPY)
  141.       END IF
  142.  
  143.  
  144. C***********************************************************************
  145. C Read the PDS label, make tests, return the following information.
  146. C
  147. C NLREC   = number of label records in file
  148. C NHREC   = number of histogram records in file
  149. C NIREC   = number of image records in file
  150. C ICHKSUM = check sum of image found on labels
  151. C INL     = number of lines in image
  152. C INS     = number of samples in image
  153. C IERROR  = error return code
  154. C***************************************************************************
  155.       CALL RDLAB(ID, NLREC, NHREC, NIREC, ICHKSUM, INL, INS, IERROR)
  156.       IF (IERROR.NE.0) GOTO 9010
  157.  
  158.       WRITE(IOUT,975) INL,INS
  159.   975 FORMAT(' Number of lines and samples: ',2i5)
  160.  
  161. C***********************************************************************
  162. C Read the image histogram object
  163. C***********************************************************************
  164.       DO I = 1,NHREC
  165.          READ(ID,'(A)',END=9015) HSTR((I-1)*INS+1:(I-1)*INS+INS)
  166.       END DO
  167.  
  168. C**********************************************************************
  169. C Read the image data
  170. C**********************************************************************
  171.       DO I = 1,NIREC
  172.          READ(ID,'(A)',END=9015) STR(1:INS)
  173.          CALL B2B(BUF,KBUF((I-1)*INS+1),INS)
  174.       END DO
  175.  
  176.       CLOSE (UNIT=ID)
  177.  
  178.       NCOL = INS
  179.       NROW = INL
  180.       NPIXEL = NROW*NCOL
  181.       IQ=0
  182.  
  183. C***************************************************************************
  184. C Find low 0.1% of histogram maximum
  185. C***************************************************************************
  186.       ICNT = 0
  187.       IMINMAX = NPIXEL*0.001
  188.       LSMIN = 0
  189.       DO I = 2,NHIST
  190.          ICNT = ICNT + IHIST(I)
  191.          IF (ICNT.GT.IMINMAX) THEN
  192.             LSMIN = I
  193.             IF (LSMIN.LT.0) LSMIN = 0
  194.             GOTO 1010
  195.          END IF
  196.       END DO
  197.  1010 CONTINUE
  198.  
  199. C***************************************************************************
  200. C Find the high 0.1% of histogram maximum
  201. C***************************************************************************
  202.       ICNT = 0
  203.       LSMAX = 255
  204.       DO I = NHIST,2,-1
  205.          ICNT = ICNT + IHIST(I)
  206.          IF (ICNT.GT.IMINMAX) THEN
  207.             LSMAX = I
  208.             IF (LSMAX.GT.255) LSMAX = 255
  209.             GOTO 1020
  210.          END IF
  211.       END DO
  212.  1020 CONTINUE
  213.  
  214. C**************************************************************************
  215. C  Perform an  auto-stretch before display of the data.
  216. C  The LSMIN and LSMAX parameters specify the range of data for stretch.
  217. C**************************************************************************
  218.       CALL LINSTR(KBUF,KBUF,NPIXEL,IEXCL,LSMIN,LSMAX,NLEV)
  219.  
  220. C***************************************************************************
  221. C Display the image
  222. C***************************************************************************
  223.       CALL UIS$IMAGE(VD_ID,1,X1,Y1,X2,Y2,NCOL,NROW,8,KBUF)
  224.  
  225. C****************************************************************************
  226. C All done
  227. C***************************************************************************
  228.       GOTO 1000
  229.  
  230.  9000 CONTINUE
  231.       CALL UIS$DELETE_DISPLAY(VD_ID)
  232.       STOP
  233. C*************************************************************************
  234. C Handle some errors
  235. C*************************************************************************
  236.  9010 CONTINUE
  237.       WRITE(IOUT,810)
  238.   810 FORMAT(' *** ERROR *** Can not read PDS labels on MDIM input')
  239.       GOTO 9000
  240.  
  241.  9015 CONTINUE
  242.       WRITE(IOUT,815)
  243.   815 FORMAT(' *** ERROR *** Unexpected end-of-file in MDIM input')
  244.       GOTO 9000
  245.  
  246.       END
  247.       SUBROUTINE LINSTR(IA,JA,N,IEXCL,MIN,MAX,NLEV)
  248.       BYTE IA(N),JA(N)
  249.  
  250.       F=FLOAT(NLEV-1)/(MAX-MIN)
  251.  
  252.       DO 40 I = 1,N
  253.          J=IA(I)
  254.          IF (J.LT.0) J=J+256
  255.          IF (J.LE.MIN) J=MIN
  256.          IF (J.GE.MAX) J=MAX
  257.          J=F*(J-MIN)+.5
  258.          J = J + 128
  259.          IF (J.GE.128) J=J-256
  260.          JA(I)=J
  261.  40   CONTINUE
  262.       RETURN
  263.       END
  264.       SUBROUTINE RDLAB(ID,NLREC,NHREC,NIREC,ICHKSUM,INL,INS,IERROR)
  265. C***********************************************************************
  266. C Read image label records and test for errors, return the parameters:
  267. C
  268. C NLREC   = number of label records
  269. C NHREC   = number of histogram records
  270. C NIREC   = number of image records
  271. C ICHKSUM = check sum in image file
  272. C INL     = number of lines
  273. C INS     = number of samples
  274. C IERROR  = error return code
  275. C**************************************************************************
  276.       COMMON /PRT/ IPR,IIN
  277.       CHARACTER*32768 LABSTR
  278.       
  279.       IERROR = 0
  280.       LABSTR = ' '
  281.  
  282.       IREC = 1
  283.       READ(ID,900,END=9005) NCHAR,LABSTR(1:NCHAR)
  284.   900 FORMAT(Q,A)
  285.  
  286.       IF (NCHAR.LE.250) THEN
  287.          IREC = 2
  288.          I1 = NCHAR + 1
  289.          I2 = 2*NCHAR
  290.          READ(ID,900,END=9005) NCHAR,LABSTR(I1:I2)
  291.       END IF
  292.  
  293. C************************************************************************
  294. C Determine the number of label records
  295. C************************************************************************
  296.       I = INDEX(LABSTR(1:IREC*NCHAR),'LABEL_RECORDS ')
  297.       IF (I.EQ.0) GOTO 9010
  298.       J = INDEX(LABSTR(I:IREC*NCHAR),'=')
  299.       IF (J.EQ.0) GOTO 9010
  300.       READ(LABSTR(I+J+1:I+J+2),'(i2)') NLREC
  301.  
  302. C***********************************************************************
  303. C Read the remaining label records
  304. C***********************************************************************
  305.       IB = 1
  306.       NBYTES = IREC*NCHAR
  307.       KREC = IREC
  308.       DO ILAB = 1,NLREC-KREC
  309.          IB = IB + IREC*NCHAR
  310.          IREC = 1
  311.          READ(ID,900,END=9005) NCHAR,LABSTR(IB:IB+NCHAR)
  312.          NBYTES = NBYTES + NCHAR
  313.       END DO
  314.       NCHAR = NBYTES
  315.       
  316. C************************************************************************
  317. C Find pointer to IMAGE_HISTOGRAM
  318. C************************************************************************
  319.       I = INDEX(LABSTR(1:NCHAR),'^IMAGE_HISTOGRAM ')
  320.       IF (I.EQ.0) GOTO 9020
  321.       J = INDEX(LABSTR(I:NCHAR),'=')
  322.       IF (J.EQ.0) GOTO 9020
  323.       READ(LABSTR(I+J+1:I+J+2),'(i2)') IHPOINT
  324.  
  325. C*************************************************************************
  326. C Find pointer to IMAGE
  327. C************************************************************************
  328.       I = INDEX(LABSTR(1:NCHAR),'^IMAGE ')
  329.       IF (I.EQ.0) GOTO 9030
  330.       J = INDEX(LABSTR(I:),'=')
  331.       IF (J.EQ.0) GOTO 9030
  332.       READ(LABSTR(I+J+1:I+J+2),'(I2)') IMPOINT
  333.  
  334. C************************************************************************
  335. C Find CHECKSUM 
  336. C************************************************************************
  337.       I = INDEX(LABSTR(1:NCHAR),'CHECKSUM ')
  338.       IF (I.EQ.0) GOTO 9040
  339.       J = INDEX(LABSTR(I:),'=')
  340.       IF (J.EQ.0) GOTO 9040
  341.       READ(LABSTR(I+J+1:I+J+9),'(I9)') ICHKSUM
  342.  
  343. C************************************************************************
  344. C Find LINES
  345. C************************************************************************
  346.       I = INDEX(LABSTR(1:NCHAR),' LINES ')
  347.       IF (I.EQ.0) GOTO 9050
  348.       J = INDEX(LABSTR(I:),'=')
  349.       IF (J.EQ.0) GOTO 9050
  350.       IFIRST = I + J + 1
  351.       ILAST = 0
  352.       I = IFIRST
  353.       DO WHILE(ILAST.EQ.0)
  354.          IF (LABSTR(I:I).NE.' ') THEN
  355.             IF (LABSTR(I:I).LT.'0'.OR.LABSTR(I:I).GT.'9') THEN
  356.                ILAST = I - 1
  357.             END IF
  358.          END IF      
  359.          I = I + 1
  360.       END DO     
  361.  
  362.       N = ILAST-IFIRST+1
  363.       READ(LABSTR(IFIRST:ILAST),'(I<N>)') INL
  364.       
  365. C************************************************************************
  366. C Find LINE_SAMPLES
  367. C************************************************************************
  368.       I = INDEX(LABSTR(1:NCHAR),' LINE_SAMPLES ')
  369.       IF (I.EQ.0) GOTO 9060
  370.       J = INDEX(LABSTR(I:),'=')
  371.       IF (J.EQ.0) GOTO 9060
  372.       IFIRST = I + J + 1
  373.       ILAST = 0
  374.       I = IFIRST
  375.       DO WHILE(ILAST.EQ.0)
  376.          IF (LABSTR(I:I).NE.' ') THEN
  377.             IF (LABSTR(I:I).LT.'0'.OR.LABSTR(I:I).GT.'9') THEN
  378.                ILAST = I - 1
  379.             END IF
  380.          END IF      
  381.          I = I + 1
  382.       END DO     
  383.  
  384.       N = ILAST-IFIRST+1
  385.       READ(LABSTR(IFIRST:ILAST),'(I<N>)') INS
  386.  
  387. C*************************************************************************  
  388. C Find the number of FILE_RECORDS 
  389. C*************************************************************************
  390.       I = INDEX(LABSTR(1:NCHAR),'FILE_RECORDS ')
  391.       IF (I.EQ.0) GOTO 9070
  392.       J = INDEX(LABSTR(I:),'=')
  393.       IF (J.EQ.0) GOTO 9070
  394.       READ(LABSTR(I+J+1:I+J+4),'(I4)') IFRECS
  395.  
  396. C**********************************************************************
  397. C Make sure END/cr/lf sequence exits
  398. C**********************************************************************
  399.       I = INDEX(LABSTR(1:NCHAR),'END'//CHAR(13)//CHAR(10))
  400.       IF (I.EQ.0) GOTO 9080
  401.  
  402. C***********************************************************************
  403. C Let's do some calculations. Determine:
  404. C NHREC,NIREC
  405. C**********************************************************************
  406.       NHREC = IMPOINT - IHPOINT
  407.       NIREC = IFRECS - IMPOINT +1
  408.       RETURN 
  409.  
  410. C***********************************************************************
  411. C Handle some errors
  412. C************************************************************************
  413.  9005 CONTINUE
  414.       WRITE(IPR,7005)
  415.  7005 FORMAT(
  416.      .' *** ERROR *** Unexpected end-of-file encountered in RDLAB')
  417.       IERROR = 1
  418.       RETURN
  419.  
  420.  9010 CONTINUE
  421.       WRITE(IPR,7010)
  422.  7010 FORMAT(
  423.      .' *** ERROR *** Error with LABEL_RECORDS keyword')
  424.       IERROR = 1
  425.       RETURN
  426.  
  427.  9020 CONTINUE
  428.       WRITE(IPR,7020)
  429.  7020 FORMAT(
  430.      .' *** ERROR *** Error in ^IMAGE_HISTOGRAM keyword')
  431.       IERROR = 1
  432.       RETURN
  433.  
  434.  9030 CONTINUE
  435.       WRITE(IPR,7030)
  436.  7030 FORMAT(
  437.      .' *** ERROR *** Error in ^IMAGE keyword')
  438.       IERROR = 1
  439.       RETURN
  440.  
  441.  9040 CONTINUE
  442.       WRITE(IPR,7040)
  443.  7040 FORMAT(
  444.      .' *** ERROR *** Error in CHECKSUM keyword')
  445.       IERROR = 1
  446.       RETURN
  447.  
  448.  9050 CONTINUE
  449.       WRITE(IPR,7050)
  450.  7050 FORMAT(
  451.      .' *** ERROR *** Error in LINES keyword')
  452.       IERROR = 1
  453.       RETURN
  454.  
  455.  9060 CONTINUE
  456.       WRITE(IPR,7060)
  457.  7060 FORMAT(
  458.      .' *** ERROR *** Error in LINE_SAMPLES keyword')
  459.       IERROR = 1
  460.       RETURN
  461.  
  462.  9070 CONTINUE
  463.       WRITE(IPR,7070)
  464.  7070 FORMAT(
  465.      .' *** ERROR *** Error in FILE_RECORDS keyword')
  466.       IERROR = 1
  467.       RETURN
  468.  
  469.  9080 CONTINUE
  470.       WRITE(IPR,7080)
  471.  7080 FORMAT(
  472.      .' *** ERROR *** END//cr//lf sequence not found in labels')
  473.       IERROR = 1
  474.       RETURN
  475.       END
  476.       SUBROUTINE COLORSET(R,G,B,MAPSIZE)
  477.       REAL*4 R(0:MAPSIZE),G(0:MAPSIZE),B(0:MAPSIZE)
  478.       DO IR = 0, MAPSIZE-1
  479.          R(IR) = FLOAT(IR)/FLOAT(MAPSIZE)
  480.          G(IR) = FLOAT(IR)/FLOAT(MAPSIZE)
  481.          B(IR) = FLOAT(IR)/FLOAT(MAPSIZE)
  482.       END DO
  483.       RETURN
  484.       END
  485.       SUBROUTINE B2B(IN,OUT,INS)
  486. C****************************************************************************
  487. C B2B simply moves data from the input buffer (IN) to the output buffer (OUT)
  488. C****************************************************************************
  489.       BYTE IN(1),OUT(1)
  490.       INTEGER*4 INS
  491.       DO I = 1, INS
  492.          OUT(I) = IN(I)
  493.       END DO
  494.       RETURN
  495.       END
  496.